Political Donations of Professional Sports Team Owners
Top 25 Highest Political Donations by NFL Team Owners in 2016

Table of Owners Who Make the Most Donations
library(knitr)
library(pander)
library(tidyverse)
library(kableExtra)
##
## Attaching package: 'kableExtra'
## The following object is masked from 'package:dplyr':
##
## group_rows
owner_rank2 <- pol_donations %>% group_by(Owner, Team, League) %>%
summarise(n = n()) %>%
arrange(desc(n)) %>%
filter(n >= 65)
## `summarise()` has grouped output by 'Owner', 'Team'. You can override using the `.groups` argument.
kable(owner_rank2, caption = "<b>Who Makes the Most Donations Across All Leagues?<b>", format = "html",
col.names = c("Owner", "Team", "League", "Donations Made")) %>%
kable_styling(html_font = "Cambria", bootstrap_options = "striped",
font_size = 9)
Who Makes the Most Donations Across All Leagues?
|
Owner
|
Team
|
League
|
Donations Made
|
|
Charles Johnson
|
San Francisco Giants
|
MLB
|
213
|
|
Micky Arison
|
Miami Heat
|
NBA
|
178
|
|
John Rogers
|
Chicago Sky
|
WNBA
|
149
|
|
Dan DeVos
|
Orlando Magic
|
NBA
|
116
|
|
Jody Allen (Paul G. Allen Trust)
|
Portland Trail Blazers, Seattle Seahawks
|
NBA, NFL
|
108
|
|
Jimmy and Susan Haslam
|
Cleveland Browns
|
NFL
|
102
|
|
Ken Kendrick
|
Arizona Diamondbacks
|
MLB
|
86
|
|
Jerry Reinsdorf
|
Chicago Bulls, Chicago White Sox
|
NBA, MLB
|
78
|
|
Herbert Simon
|
Indiana Pacers, Indiana Fever
|
NBA, WNBA
|
68
|
|
Stephen M. Ross
|
Miami Dolphins
|
NFL
|
65
|
How Much Do They Donate?

Examining Top Donator
library(ggthemes)
charles_johnson <- pol_donations %>% filter(Owner == "Charles Johnson") %>%
filter(year == 2016 | year == 2018 | year == 2020)
cj_party <- charles_johnson %>% group_by(Party) %>%
summarise(n = n()) %>%
mutate(party = fct_reorder(.f = Party, .x = n)) %>%
mutate(Party = fct_relevel(party, c("Republican", "Bipartisan, but mostly Republican",
"Democrat")))
level_order2 <- factor(charles_johnson$Party, level = c('Republican', 'Democrat', 'Bipartisan, but mostly Republican'))
ggplot(data = cj_party, aes(x = party, y = n, fill = Party)) +
geom_col() +
coord_flip() +
scale_fill_viridis_d(option = "plasma") +
labs(title = "Is There Any Political Party Receiving More Support From Charles Johnson?",
x = " ",
y = "Count of Donations") +
theme(legend.position = "bottom",
plot.title = element_text(family = "mono",
face = "bold",
hjust = 0.5,
size = 13,
margin = margin(c(t = 50,
b = 50)),
vjust = 10),
axis.text = element_text(family = "mono"),
legend.title = element_text(family = "mono",
face = "bold"),
legend.text = element_text(family = "mono"),
axis.ticks.y = element_blank(),
axis.ticks.x = element_blank(),
axis.title.x = element_text(family = "mono",
size = 9,
face = "italic",
margin = margin(t = 20)))

cj_party2 <- cj_party %>% select(n, party)
ggplot(data = cj_party, aes(x = party, y = n, fill = Party)) +
geom_col() +
annotate(geom = "table") +
coord_flip()

What Are Some of These Organizations?
organizations <- charles_johnson %>% group_by(Recipient, Party) %>%
summarise(n = n()) %>%
arrange(desc(n)) %>%
filter(n >= 2)
## `summarise()` has grouped output by 'Recipient'. You can override using the `.groups` argument.
kable(organizations, caption = "<b>What Are Some Organizations Charles Johnson Donates To?<b>",
col.names = c("Recipient", "Political Party", "Amount of Donations Made")) %>%
kable_styling(html_font = "Cambria", bootstrap_options = "striped",
font_size = 15) %>%
scroll_box(height = "500px")
What Are Some Organizations Charles Johnson Donates To?
|
Recipient
|
Political Party
|
Amount of Donations Made
|
|
CONGRESSIONAL LEADERSHIP FUND
|
Republican
|
3
|
|
MOONEY VICTORY FUND
|
Republican
|
3
|
|
SENATE LEADERSHIP FUND
|
Republican
|
3
|
|
TRUMP VICTORY
|
Republican
|
3
|
|
VIGOP (VIRGIN ISLANDS REPUBLICAN PARTY)
|
Republican
|
3
|
|
ALEX MOONEY FOR CONGRESS
|
Republican
|
2
|
|
CHIP ROY FOR CONGRESS
|
Republican
|
2
|
|
CORNYN MAJORITY COMMITTEE
|
Republican
|
2
|
|
FASO FOR CONGRESS
|
Republican
|
2
|
|
HURD FOR CONGRESS
|
Republican
|
2
|
|
INVESTMENT COMPANY INSTITUTE POLITICAL ACTION COMMITTEE
|
Bipartisan, but mostly Republican
|
2
|
|
JACKIE SPEIER FOR CONGRESS
|
Democrat
|
2
|
|
KATKO FOR CONGRESS
|
Republican
|
2
|
|
MAST VICTORY COMMITTEE
|
Republican
|
2
|
|
MCSALLY FOR SENATE INC
|
Republican
|
2
|
|
RESTORATION PAC
|
Republican
|
2
|
|
TEAM RYAN
|
Republican
|
2
|
|
TRUE NORTH PAC
|
Republican
|
2
|
|
WALTERS FOR CONGRESS
|
Republican
|
2
|
|
ZELDIN FOR CONGRESS
|
Republican
|
2
|
Organizations Receiving Most Donations Across All Leagues
recipients <- pol_donations %>% group_by(Recipient, Party) %>%
summarise(n = n()) %>%
arrange(desc(n)) %>%
filter(n >= 15) %>%
ungroup() %>%
mutate(recipient = fct_reorder(.f = Recipient, .x = n)) %>%
mutate(Party = fct_relevel(Party, c("Bipartisan", "Republican", "Democrat")))
## `summarise()` has grouped output by 'Recipient'. You can override using the `.groups` argument.
new_names <- c("Collins For Senator", "McSally for Senate Inc.",
"ActBlue", "Portman For Senate Committee", "NRCC",
"NRSC", "Hillary Victory Fund", "Team Ryan",
"Office of the Commissioner of MLB PAC", "Gridirion PAC")
ggplot(data = recipients, aes(x = recipient, y = n, colour = Party)) +
geom_point() +
geom_segment(aes(x = recipient, xend = recipient, y = 0, yend = n)) +
coord_flip() +
labs(x = " ",
y = "Count of Donations") +
labs(title = "Organizations Receiving Most Donations Among All Owners") +
scale_colour_brewer(palette = "Dark2") +
theme(legend.position = "bottom") +
scale_x_discrete(labels = new_names) +
theme(plot.title = element_text(family = "mono",
face = "bold",
margin = margin(c(t = 50,
b = 50)),
vjust = 10),
axis.text = element_text(family = "mono"),
axis.title = element_text(family = "mono",
size = 8),
axis.title.x = element_text(size = 10,
margin = margin(t = 20,
b = 10)),
legend.title = element_text(family = "mono",
face = "bold"),
legend.text = element_text(family = "mono"),
axis.ticks = element_blank(),
legend.box.background = element_rect())

pol_donations %>% group_by(League) %>%
summarise(n = n()) %>%
arrange(desc(n))
## # A tibble: 16 × 2
## League n
## <chr> <int>
## 1 MLB 746
## 2 NBA 462
## 3 NFL 444
## 4 NHL 329
## 5 WNBA 274
## 6 NBA, WNBA 118
## 7 NBA, NFL 109
## 8 NBA, NHL 109
## 9 NBA, MLB 84
## 10 NASCAR 79
## 11 NBA, NHL, WNBA 15
## 12 NHL, NFL 12
## 13 MLB, NHL 7
## 14 MLB, WNBA 6
## 15 NBA, NFL, NHL 3
## 16 MLB, NASCAR 1
Blockbusters: A blockbuster is a Hollywood movie that’s made with a large budget and big stars. A true blockbuster is extremely popular and brings in a lot of money (https://www.vocabulary.com/dictionary/blockbuster).
## # A tibble: 430 × 13
## release_year rank_in_year imdb_rating mpaa_rating film_title film_budget
## <dbl> <dbl> <dbl> <chr> <chr> <dbl>
## 1 2019 1 8.5 PG-13 Avengers: Endg… 356000000
## 2 2019 2 7 PG The Lion King 260000000
## 3 2019 3 7.2 PG Frozen II 150000000
## 4 2019 4 7.6 PG-13 Spider-Man: Fa… 160000000
## 5 2019 5 6.9 PG-13 Captain Marvel 175000000
## 6 2019 6 7.9 G Toy Story 4 200000000
## 7 2019 7 8.6 R Joker 55000000
## 8 2019 8 7 PG Aladdin 183000000
## 9 2019 9 6.9 PG-13 Star Wars: Epi… 200000000
## 10 2019 10 6.5 PG-13 Fast & Furious… 200000000
## # … with 420 more rows, and 7 more variables: length_in_min <dbl>,
## # domestic_distributor <chr>, worldwide_gross <dbl>, domestic_gross <dbl>,
## # genre_1 <chr>, genre_2 <chr>, genre_3 <chr>
Blockbuster Ratings: 1977 to 2019
## # A tibble: 5 × 2
## mpaa_rating n
## <chr> <int>
## 1 G 23
## 2 PG 133
## 3 PG-13 178
## 4 R 95
## 5 <NA> 1

## # A tibble: 4 × 2
## mpaa_rating n
## <chr> <int>
## 1 G 23
## 2 PG 133
## 3 PG-13 178
## 4 R 95
Has the Budget for Blockbusters Increased Throughout Time?
ggplot(data = blockbusters, aes(x = release_year, y = film_budget, colour = release_year)) +
geom_point() +
geom_smooth(se = FALSE, method = "lm", colour = "black") +
labs(x = "Release Year",
y = "Film Budget",
title = "Has the Budget for Blockbuster Films Increased Throughout Time?",
subtitle = "Film Budget for Blockbusters: 1977-2019") +
theme_bw() +
scale_colour_viridis_c() +
theme(legend.position = "none",
plot.title = element_text(family = "mono",
face = "bold",
margin = margin(c(t = 50, b = 50)),
vjust = 10),
plot.subtitle = element_text(family = "mono",
face = "italic",
vjust = 5),
axis.title = element_text(family = "mono",
face = "bold"),
axis.text = element_text(family = "mono"),
axis.ticks = element_blank(),
axis.title.x = element_text(margin = margin(c(l = 20))),
axis.title.y = element_text(margin = margin(c(t = 20, b = 20, r = 20))))
## `geom_smooth()` using formula 'y ~ x'

## need to add more to this visualization
Which American/Domestic Distributor Has Produced the Most Blockbusters 1977-2019
blockbusters3 <- blockbusters %>% group_by(domestic_distributor) %>%
summarise(n = n()) %>%
arrange(desc(n)) %>%
mutate(order = fct_reorder(.f = domestic_distributor, .x = n)) %>%
filter(!n == 1)
ggplot(data = blockbusters3, aes(x = order, y = n, fill = order)) +
geom_point() +
geom_segment(aes(x = order, xend = order, y = 0, yend = n)) +
coord_flip() +
geom_label(data = blockbusters3, aes(label = n), show.legend = FALSE) +
labs(x = "Amount of Films Produced",
y = "Domestic Distributor",
title = "Amount of Blockbusters Produced by Domestic Distributors: 1977-2019") +
theme_bw() +
theme(legend.position = "none",
plot.title = element_text(family = "mono",
face = "bold",
margin = margin(c(t = 50)),
vjust = 10),
axis.title = element_text(family = "mono",
face = "bold"),
axis.text = element_text(family = "mono"),
axis.text.y = element_text(face = "italic"),
axis.ticks = element_blank(),
axis.title.x = element_text(margin = margin(c(b = 20))),
axis.title.y = element_text(margin = margin(c(t = 30, r = 30))))

Work in Progress
blockbusters
## # A tibble: 430 × 13
## release_year rank_in_year imdb_rating mpaa_rating film_title film_budget
## <dbl> <dbl> <dbl> <chr> <chr> <dbl>
## 1 2019 1 8.5 PG-13 Avengers: Endg… 356000000
## 2 2019 2 7 PG The Lion King 260000000
## 3 2019 3 7.2 PG Frozen II 150000000
## 4 2019 4 7.6 PG-13 Spider-Man: Fa… 160000000
## 5 2019 5 6.9 PG-13 Captain Marvel 175000000
## 6 2019 6 7.9 G Toy Story 4 200000000
## 7 2019 7 8.6 R Joker 55000000
## 8 2019 8 7 PG Aladdin 183000000
## 9 2019 9 6.9 PG-13 Star Wars: Epi… 200000000
## 10 2019 10 6.5 PG-13 Fast & Furious… 200000000
## # … with 420 more rows, and 7 more variables: length_in_min <dbl>,
## # domestic_distributor <chr>, worldwide_gross <dbl>, domestic_gross <dbl>,
## # genre_1 <chr>, genre_2 <chr>, genre_3 <chr>
interest <- blockbusters %>% mutate(rank = rank(desc(imdb_rating))) %>%
select(rank, everything()) %>%
arrange(rank) %>%
slice(1:5) %>%
mutate(film_title = fct_recode(film_title,
LOTR_The_Return_Of_The_King = "The Lord of the Rings: The Return of the King",
LOTR_Fellowship_Of_The_Ring = "The Lord of the Rings: The Fellowship of the Ring"))
interest
## # A tibble: 5 × 14
## rank release_year rank_in_year imdb_rating mpaa_rating film_title film_budget
## <dbl> <dbl> <dbl> <dbl> <chr> <fct> <dbl>
## 1 1 2008 1 9 PG-13 The Dark … 185000000
## 2 2.5 2003 1 8.9 PG-13 LOTR_The_… 94000000
## 3 2.5 1993 4 8.9 R Schindler… 22000000
## 4 5 2010 4 8.8 PG-13 Inception 160000000
## 5 5 2001 2 8.8 PG-13 LOTR_Fell… 93000000
## # … with 7 more variables: length_in_min <dbl>, domestic_distributor <chr>,
## # worldwide_gross <dbl>, domestic_gross <dbl>, genre_1 <chr>, genre_2 <chr>,
## # genre_3 <chr>
interest2 <- blockbusters %>% mutate(rank = rank(imdb_rating)) %>%
select(rank, everything()) %>%
arrange(rank) %>%
slice(1:5)
interest2
## # A tibble: 5 × 14
## rank release_year rank_in_year imdb_rating mpaa_rating film_title film_budget
## <dbl> <dbl> <dbl> <dbl> <chr> <chr> <dbl>
## 1 1 1983 5 3.7 PG Jaws 3-D 20500000
## 2 2 1983 10 4.6 PG Staying A… 22000000
## 3 3 2009 7 4.7 PG-13 The Twili… 50000000
## 4 4.5 2011 4 4.9 PG-13 The Twili… 110000000
## 5 4.5 1994 6 4.9 PG The Flint… 46000000
## # … with 7 more variables: length_in_min <dbl>, domestic_distributor <chr>,
## # worldwide_gross <dbl>, domestic_gross <dbl>, genre_1 <chr>, genre_2 <chr>,
## # genre_3 <chr>
library(ggrepel)
ggplot(data = interest, aes(x = release_year, y = domestic_gross)) +
geom_point(aes(colour = imdb_rating)) +
geom_label_repel(data = interest, aes(label = film_title)) +
geom_point(data = interest2, aes(x = release_year, y = domestic_gross, colour = imdb_rating)) +
geom_label_repel(data = interest2, aes(label = film_title))

History of Rock
## # A tibble: 5,484 × 18
## index name artist release_date length popularity danceability...7
## <dbl> <chr> <chr> <dbl> <dbl> <dbl> <dbl>
## 1 0 Smells Like T… Nirvana 1991 5.03 74 0.502
## 2 1 Stairway to H… Led Zep… 1971 8.05 78 0.338
## 3 2 Bohemian Rhap… Queen 1975 5.91 74 0.392
## 4 3 Imagine - Rem… John Le… 1971 3.13 77 0.547
## 5 4 (I Can't Get … The Rol… 1965 3.71 77 0.723
## 6 5 Hotel Califor… Eagles 1976 6.52 83 0.579
## 7 6 Enter Sandman Metalli… 1991 5.53 74 0.579
## 8 7 Whole Lotta L… Led Zep… 1969 5.56 77 0.412
## 9 8 Comfortably N… Pink Fl… 1979 6.37 74 0.472
## 10 9 One U2 1991 4.60 76 0.392
## # … with 5,474 more rows, and 11 more variables: acousticness <dbl>,
## # danceability...9 <dbl>, energy <dbl>, instrumentalness <dbl>, key <dbl>,
## # liveness <dbl>, loudness <dbl>, speechiness <dbl>, tempo <dbl>,
## # time_signature <dbl>, valence <dbl>
Most Popular Nirvana Songs
history_of_rock %>% group_by(artist) %>%
summarise(n = n()) %>% arrange(desc(n))
## # A tibble: 1,738 × 2
## artist n
## <chr> <int>
## 1 Various Artists 116
## 2 The Beatles 84
## 3 The Rolling Stones 58
## 4 Led Zeppelin 52
## 5 AC/DC 43
## 6 Bruce Springsteen 42
## 7 Elvis Presley 33
## 8 Pink Floyd 31
## 9 Bob Dylan 29
## 10 Metallica 29
## # … with 1,728 more rows
nirvana <- history_of_rock %>% rename(Popularity = 'popularity') %>%
filter(artist == "Nirvana") %>% arrange(desc(Popularity)) %>%
mutate(order = fct_reorder(.f = name, .x = Popularity)) %>%
rename(Release_Date = 'release_date')
nirvana %>% select(order, everything())
## # A tibble: 19 × 19
## order index name artist Release_Date length Popularity danceability...7
## <fct> <dbl> <chr> <chr> <dbl> <dbl> <dbl> <dbl>
## 1 Heart-S… 270 Heart-… Nirva… 1993 4.69 75 0.256
## 2 Smells … 0 Smells… Nirva… 1991 5.03 74 0.502
## 3 The Man… 497 The Ma… Nirva… 1994 4.35 74 0.483
## 4 Come As… 37 Come A… Nirva… 1991 3.65 72 0.5
## 5 About A… 371 About … Nirva… 2002 2.78 70 0.409
## 6 All Apo… 194 All Ap… Nirva… 1993 3.89 69 0.446
## 7 Lithium 169 Lithium Nirva… 1991 4.28 68 0.678
## 8 Lake Of… 723 Lake O… Nirva… 1994 2.93 66 0.541
## 9 In Bloo… 155 In Blo… Nirva… 1991 4.25 65 0.436
## 10 Rape Me 687 Rape Me Nirva… 1993 2.83 64 0.42
## 11 Dumb 1325 Dumb Nirva… 1993 2.53 64 0.697
## 12 Drain Y… 3015 Drain … Nirva… 1991 3.73 60 0.325
## 13 Breed 742 Breed Nirva… 1991 3.07 59 0.262
## 14 Polly 1103 Polly Nirva… 1991 2.90 58 0.83
## 15 Sliver 2642 Sliver Nirva… 1992 2.27 58 0.428
## 16 Pennyro… 3902 Pennyr… Nirva… 1993 3.65 58 0.428
## 17 On A Pl… 2416 On A P… Nirva… 1991 3.24 54 0.428
## 18 Verse C… 3117 Verse … Nirva… 1991 3.21 35 0.529
## 19 Rainbow… 2914 Rainbo… Nirva… 2018 2.64 25 0.499
## # … with 11 more variables: acousticness <dbl>, danceability...9 <dbl>,
## # energy <dbl>, instrumentalness <dbl>, key <dbl>, liveness <dbl>,
## # loudness <dbl>, speechiness <dbl>, tempo <dbl>, time_signature <dbl>,
## # valence <dbl>
plot3 <- ggplot(data = nirvana, aes(x = order, y = Popularity, label = Popularity, colour = Popularity)) +
geom_point() +
geom_segment(aes(x = order, xend = order, y = 0, yend = Popularity)) +
coord_flip() +
labs(title = "Most Popular Nirvana Songs: 1991-2018",
colour = "Popularity",
x = " ",
y = " ") +
theme_bw() +
scale_colour_viridis_b() +
theme(legend.position = "none")
ggplotly(plot3, tooltip = "label")
Trying to Make Density Ridges Plot
## install.packages("ggridges")
library(ggridges)
nirvana_small <- nirvana %>% slice(1:5) %>%
mutate(order = fct_reorder(.f = name, .x = valence))
ggplot(data = nirvana_small, aes(x = order, y = valence)) +
geom_density_ridges() +
coord_flip() +
labs(x = "Title",
y = "Valence")
## Picking joint bandwidth of NaN

Works in Progress - Simple Visualizations
nirvana_line <- nirvana %>% rename(Title = 'name')
plot10 <- ggplot(data = nirvana_line, aes(x = Release_Date, y = Popularity, label = Title)) +
geom_line() +
geom_point(colour = "darkolivegreen") +
labs(x = "Release Date",
y = "Popularity",
title = "Comparing Popularity by Release Date") +
theme_bw() +
theme(legend.position = "none")
ggplotly(plot10, tooltip = "label")
table <- history_of_rock %>% group_by(artist) %>%
summarise(mean = mean(popularity)) %>%
arrange(desc(mean)) %>%
slice(1:10)
top10 <- history_of_rock %>% arrange(desc(popularity)) %>% slice(1:10)
Unemployment Data Set
library(lubridate)
##
## Attaching package: 'lubridate'
## The following objects are masked from 'package:base':
##
## date, intersect, setdiff, union
unemployment <- read_csv("data/unemployment_data_us.csv")
## Rows: 132 Columns: 13
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (2): Month, Date
## dbl (11): Year, Primary_School, High_School, Associates_Degree, Professional...
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
ggplot(data = unemployment, aes(x = Date, y = Professional_Degree)) +
geom_point()
## Warning: Removed 9 rows containing missing values (geom_point).
